'' Downloads remote file to local disk
'' parses the links in the downloaded file and saves
'' them to a text file, the hyperlink RegExp is
'' only an example, write your own if you want 
'' it to be usable

'Option Explicit
'On Error Resume Next
uName = "Username"
uPass = "Password"

LOG_FILE_NAME = "url's.txt"
LOCAL_FILE = "index_dump.html"

sLinkRegex = "href=""(http:/[^""'']*.htm)"""

urlRoot = InputBox (vbcr & vbcr & vbcr & vbcr & vbcr & "URL Prefix", "cases", _
	"http://news.google.com")

if urlRoot = "" then
    MsgBox "Script aborted", vbOkOnly, "VBS Downloader"
    WScript.Quit
end if


downloadFile urlRoot, ".", LOCAL_FILE,uName, uPass

msgbox "Index saved to " & LOCAL_FILE

strPageData = readTextFile(LOCAL_FILE)

' msgbox "File read successfully."

'Set objDictLinks = CreateObject("Scripting.Dictionary")

Dim objDictLinks
Set objDictLinks = getMatches (sLinkRegex, strPageData)

'msgbox 

Set fso = CreateObject("Scripting.FileSystemObject")
Set urlFile = fso.CreateTextFile(LOG_FILE_NAME, True)

For Each lnk In objDictLinks
     urlFile.WriteLine lnk
Next

urlFile.Close

msgbox "Operation completed!" & vbcr & _
	"Total links found: " & objDictLinks.Count

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

public function downloadFile(docUrl, saveDir, saveName, uName, uPass)

    Const adTypeBinary = 1
    Const adSaveCreateOverWrite = 2
    Set xmlHttpDoc = CreateObject("Microsoft.XMLHTTP")
    '' Set xmlHttpDoc = CreateObject("MSXML2.XMLHTTP")
    xmlHttpDoc.Open "GET", docUrl, False, uName, uPass
    xmlHttpDoc.send
    'DataBin = xmlHttpDoc.responseBody
    
    Dim AdoDb
    Set AdoDb = CreateObject("ADODB.Stream")
    
    AdoDb.Type = adTypeBinary
    AdoDb.Open
    AdoDb.Write xmlHttpDoc.responseBody
    AdoDb.SaveToFile saveDir & "\" & Replace(saveName,"%20"," "), adSaveCreateOverWrite
    
    Set AdoDb = Nothing
    Set xmlHttpDoc = Nothing

end function

public Function readTextFile(filename)

    dim file, text, readfile, contents
    set file = CreateObject("Scripting.FileSystemObject")
    set readfile = file.OpenTextFile(filename, 1, false)

    readTextFile = readfile.ReadAll
    readfile.close

End Function

Function getMatches(strRegex, strInput)

    Set getMatches = CreateObject("Scripting.Dictionary")

    Set myRegExp = New RegExp

    With myRegExp
        .IgnoreCase = True
	.Global = True
	.Pattern = strRegex
    End With

    Set matches = myRegExp.Execute(strInput)
    For Each aMatch In matches
         ' msgbox aMatch.SubMatches(0)
        getMatches.Add aMatch.SubMatches(0), aMatch.SubMatches(0)
    Next

End Function